home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / bin / run-mailcap < prev    next >
Encoding:
Text File  |  2006-12-06  |  12.9 KB  |  540 lines
  1. #! /usr/bin/perl
  2. ###############################################################################
  3. #
  4. #  Run-Mailcap:  Run a program specified in the mailcap file based on a mime
  5. #  type.
  6. #
  7. #  Written by Brian White <bcwhite@pobox.com>
  8. #  This file has been placed in the public domain (the only true "free").
  9. #
  10. ###############################################################################
  11.  
  12.  
  13. $debug=0;
  14. $etcmimetyp="/etc/mime.types";
  15. $shrmimetyp="/usr/share/etc/mime.types";
  16. $locmimetyp="/usr/local/etc/mime.types";
  17. $usrmimetyp="$ENV{HOME}/.mime.types";
  18. $xtermprgrm="/usr/bin/x-terminal-emulator";    # xterm?
  19. $defmimetyp="application/*";
  20. $quotedsemi=chr(255);
  21. $quotedprct=chr(254);
  22. $retcode=0;
  23.  
  24.  
  25. %patterntypes =
  26. (
  27.  '(^|/)crontab[^/]+$'                            => 'text/x-crontab',            #'
  28.  '/man\d*/'                                        => 'application/x-troff-man',    #'
  29.  '\.\d[^\.]*$'                                    => 'application/x-troff-man',    #'
  30. );
  31.  
  32.  
  33.  
  34. sub Usage {
  35.     my($error) = @_;
  36.     print STDERR $error,"\n\n" if $error;
  37.  
  38.     print STDERR "Use: $0 <--opt=val> [...] [<mime-type>:[<encoding>:]]<file> [...]\n\n";
  39.     print STDERR "Options:\n";
  40.     print STDERR "  action        specify what action to do on these files (default=view)\n";
  41.     print STDERR "  debug         be verbose about what's going on (any non-zero value)\n";
  42.     print STDERR "\n";
  43.     print STDERR "Mime-Type:\n";
  44.     print STDERR "  any standard mime type designation in the form <class>/<subtype> -- if\n";
  45.     print STDERR "  not specified, it will be determined from the filename extension\n\n";
  46.     print STDERR "Encoding:\n";
  47.     print STDERR "  how the file (and type) has been encoded (only \"gzip\", \"bzip\", \"bzip2\"\n";
  48.     print STDERR "  and \"compress\" are supported) -- if not specified, it will be determined\n";
  49.     print STDERR "  from the filename extension\n\n";
  50.  
  51.     exit ($error ? 1 : 0);
  52. }
  53.  
  54.  
  55.  
  56. sub EncodingForFile {
  57.     my($file) = @_;
  58.     my $encoding;
  59.  
  60.     if ($file =~ m/\.gz$/)    { $encoding = "gzip";        }
  61.     if ($file =~ m/\.bz$/)    { $encoding = "bzip";        }
  62.     if ($file =~ m/\.bz2$/)    { $encoding = "bzip2";        }
  63.     if ($file =~ m/\.Z$/)    { $encoding = "compress";    }
  64.  
  65.     print STDERR " - file \"$file\" has encoding \"$encoding\"\n" if $debug && $encoding;
  66.  
  67.     return $encoding;
  68. }
  69.  
  70.  
  71.  
  72. sub ReadMimetypes {
  73.     my($file) = @_;
  74.  
  75.     return unless -r $file;
  76.  
  77.     print STDERR " - Reading mime.types file \"$file\"...\n" if $debug;
  78.     open(MIMETYPES,"<$file") || die "Error: could not read \"$file\" -- $!\n";
  79.     while (<MIMETYPES>) {
  80.         chomp; lc; s/\#.*$//;
  81.         next if (m/^\s*$/);
  82.  
  83.         my($type,@exts) = split;
  84.  
  85.         foreach (@exts) {
  86.             $mimetypes{$_} = $type unless exists $mimetypes{$_};
  87.         }
  88.     }
  89.     close MIMETYPES;
  90. }
  91.  
  92.  
  93.  
  94. sub ReadMailcap {
  95.     my($file) = @_;
  96.     my $line = "";
  97.  
  98.     return unless -r $file;
  99.  
  100.     print STDERR " - Reading mailcap file \"$file\"...\n" if $debug;
  101.     open(MAILCAP,"<$file") || die "Error: could not read \"$file\" -- $!\n";
  102.     while (<MAILCAP>) {
  103.         chomp;
  104.         s/^\s+// if $line;
  105.         $line .= $_;
  106.         next unless $line;
  107.         if ($line =~ m/^\s*\#/) {
  108.             $line = "";
  109.             next;
  110.         }
  111.         if ($line =~ m/\\$/) {
  112.             $line =~ s/\\$//;
  113.         } else {
  114.             $line =~ s/\\;/$quotedsemi/go;
  115.             $line =~ s/\\%/$quotedprct/go;
  116.             push @mailcap,$line;
  117.             $line = "";
  118.         }
  119.     }
  120.     close MAILCAP;
  121. }
  122.  
  123.  
  124.  
  125. sub TempFile {
  126.     my($template) = @_;
  127.     my($cmd,$head,$tail,$tmpfile);
  128.  
  129.     ($head,$tail) = split(/%s/,$template,2);
  130.  
  131. #    $tmpfile = POSIX::tmpnam($name);
  132. #    unlink($tmpfile);
  133.  
  134.     $cmd  = "tempfile --mode=600";
  135.     $cmd .= " --prefix $head" if $head;
  136.     $cmd .= " --suffix $tail" if $tail;
  137.  
  138.     $tmpfile = `$cmd`;
  139.     chomp($tmpfile);
  140.  
  141. #    $tmpfile = $ENV{TMPDIR};
  142. #    $tmpfile = "/tmp" unless $tmpfile;
  143. #    $tmpfile.= "/$name";
  144. #    unlink($tmpfile);
  145.  
  146.     return $tmpfile;
  147. }
  148.  
  149.  
  150.  
  151. sub SaveStdin {
  152.     my($match) = @_;
  153.     my($tmpfile,$amt,$buf);
  154.  
  155.     $tmpfile = $1 if ($match =~ m/nametemplate=(.*?)\s*($|;)/);
  156.     $tmpfile = TempFile($tmpfile);
  157.     open(TMPFILE,">$tmpfile") || die "Error: could not write \"$tmpfile\" -- $!\n";
  158.     do {
  159.         $amt = read(STDIN,$buf,102400);
  160.         print TMPFILE $buf if $amt;
  161.     } while ($amt != 0);
  162.     close(TMPFILE);
  163.  
  164.     return $tmpfile;
  165. }
  166.  
  167.  
  168.  
  169. sub DecodeFile {
  170.     my($efile,$encoding,$action) = @_;
  171.     my($file,$res);
  172.  
  173.     $file = $efile;
  174.     $file =~ s!^.*/!!;            # remove leading directories
  175.     $file =~ s!\.[^\.]*$!!;        # remove encoding extension
  176.     $file =~ s!^\.?[^\.]*!%s!;    # replace name with placeholder
  177.     $file = undef if ($efile eq '-');
  178.     my $tmpfile = TempFile($file);
  179.  
  180.     print STDERR " - decoding \"$efile\" as \"$tmpfile\"\n" if $debug;
  181.  
  182. #    unlink($tmpfile); # should still be acceptable for "compose" output even if exists
  183.     return $tmpfile if (($efile ne '-' && ! -e $efile) || $action eq 'compose');
  184.  
  185.     if ($encoding eq "gzip") {
  186.         if ($efile eq '-') {
  187.             $res = system "gzip -d >\Q$tmpfile\E";
  188.         } else {
  189.             $res = system "gzip -dc \Q$efile\E >\Q$tmpfile\E";
  190.         }
  191.     } elsif ($encoding eq "bzip") {
  192.         if ($efile eq '-') {
  193.             $res = system "bzip -d >\Q$tmpfile\E";
  194.         } else {
  195.             $res = system "bzip -dc <\Q$efile\E >\Q$tmpfile\E";
  196.         }
  197.     } elsif ($encoding eq "bzip2") {
  198.         if ($efile eq '-') {
  199.             $res = system "bzip2 -d >\Q$tmpfile\E";
  200.         } else {
  201.             $res = system "bzip2 -dc <\Q$efile\E >\Q$tmpfile\E";
  202.         }
  203.     } elsif ($encoding eq "compress") {
  204.         if ($efile eq '-') {
  205.             $res = system "uncompress >\Q$tmpfile\E";
  206.         } else {
  207.             $res = system "uncompress <\Q$efile\E >\Q$tmpfile\E";
  208.         }
  209.     } else {
  210.         die "Fatal: unknown encoding \"$encoding\" at";
  211.     }
  212.  
  213.     $res = int($res/256);
  214.     if ($res != 0) {
  215.         print STDERR "Error: could not decode \"$efile\" -- $!\n";
  216.         $retcode = 2 if ($retcode < 2);
  217.         unlink($tmpfile);
  218.         return;
  219.     }
  220.  
  221. #    chmod 0600,$tmpfile; # done already by TempFile
  222.     return $tmpfile;
  223. }
  224.  
  225.  
  226.  
  227. sub EncodeFile {
  228.     my($dfile,$efile,$encoding) = @_;
  229.     my($res);
  230.  
  231.     print STDERR " - encoding \"$dfile\" as \"$efile\"\n";
  232.  
  233.     if ($encoding eq "gzip") {
  234.         if ($efile eq '-') {
  235.             $res = system "gzip -c \Q$dfile\E";
  236.         } else {
  237.             $res = system "gzip -c \Q$dfile\E >\Q$efile\E";
  238.         }
  239.     } elsif ($encoding eq "compress") {
  240.         if ($efile eq '-') {
  241.             $res = system "compress <\Q$dfile\E";
  242.         } else {
  243.             $res = system "compress <\Q$dfile\E >\Q$efile\E";
  244.         }
  245.     } else {
  246.         die "Fatal: unknown encoding \"$encoding\" at";
  247.     }
  248.  
  249.     $res = int($res/256);
  250.     if ($res != 0) {
  251.         print STDERR "Error: could not encode \"$efile\" (left as \"$dfile\")\n";
  252.         $retcode = 2 if ($retcode < 2);
  253.         return;
  254.     }
  255.  
  256.     return $dfile;
  257. }
  258.  
  259.  
  260.  
  261. sub ExtensionMimetype {
  262.     my($ext) = @_;
  263.     my($typ);
  264.  
  265.     unless ($donemimetypes) {
  266.         ReadMimetypes($usrmimetyp);
  267.         ReadMimetypes($locmimetyp);
  268.         ReadMimetypes($shrmimetyp);
  269.         ReadMimetypes($etcmimetyp);
  270.         $donemimetypes = 1;
  271.     }
  272.  
  273.     $typ = $mimetypes{lc($ext)};
  274.  
  275.     print STDERR " - extension \"$ext\" maps to mime-type \"$typ\"\n" if $debug;
  276.     return $typ;
  277. }
  278.  
  279.  
  280.  
  281. sub PatternMimetype {
  282.     my($file) = @_;
  283.     my($key,$val);
  284.  
  285.     while (($key,$val) = each %patterntypes) {
  286.         if ($file =~ m!$key!i) {
  287.             print STDERR " - file \"$file\" maps to mime-type \"$val\"\n" if $debug;
  288.             return $val;
  289.         }
  290.     }
  291.  
  292.     print STDERR " - file \"$file\" does not conform to any known pattern\n" if $debug;
  293.     return;
  294. }
  295.  
  296.  
  297.  
  298. sub FileMimetype {
  299.     my($file) = @_;
  300.     my($ext)  = ($file =~ m!\.([^/\.]+)$!);
  301.  
  302.     my $type;
  303.  
  304.     $type = ExtensionMimetype($ext) if $ext;
  305.     $type = PatternMimetype($file) unless $type;
  306.  
  307.     return $type;
  308. }
  309.  
  310.  
  311.  
  312. foreach (@ARGV) {
  313.     print STDERR " - parsing parameter \"$_\"\n" if $debug;
  314.     if (m!^(-h|--help)$!) {
  315.         Usage();
  316.         exit(0);
  317.     } elsif (m!^--(.*?)=(.*)$!) {
  318.         print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != $2);
  319.         $ {$1}=$2;
  320.     } elsif (m!^[^/:]+/[^/:]+:[^/:]+:!) {
  321.         push @files,$_;
  322.     } elsif (m!^([^/:]+/[^/:]+):(.*)!) {
  323.         my $type = $1;
  324.         my $file = $2;
  325.         my $code = EncodingForFile($file);
  326.         push @files,"${type}:${code}:${file}";
  327.     } else {
  328.         my $file = $_;
  329.         my $code = EncodingForFile($file);
  330.         my $type;
  331.         if ($code) {
  332.             my $efile = $file;
  333.             $efile =~ s/\.[^\.]+$//;
  334.             $type = FileMimetype($efile);
  335.         } else {
  336.             $type = FileMimetype($file);
  337.         }
  338.         if ($type) {
  339.             push @files,"${type}:${code}:${file}";
  340.         } else {
  341.             print STDERR "Warning: unknown mime-type for \"$file\" -- using \"$defmimetyp\"\n";
  342.             push @files,"${defmimetyp}:${code}:${file}";
  343.         }
  344.     }
  345. }
  346.  
  347. unless ($action) {
  348.        if ($0 =~ m!(^|/)view$!)        { $action="view";    }
  349.     elsif ($0 =~ m!(^|/)see$!)        { $action="view";    }
  350.     elsif ($0 =~ m!(^|/)edit$!)        { $action="edit";    }
  351.     elsif ($0 =~ m!(^|/)change$!)    { $action="edit";    }
  352.     elsif ($0 =~ m!(^|/)compose$!)    { $action="compose";}
  353.     elsif ($0 =~ m!(^|/)print$!)    { $action="print";    }
  354.     elsif ($0 =~ m!(^|/)create$!)    { $action="compose";}
  355.     else                            { $action="view";    }
  356. }
  357.  
  358.  
  359. $mailcaps = $ENV{MAILCAPS};
  360. $mailcaps = "$ENV{HOME}/.mailcap:/etc/mailcap:/usr/local/etc/mailcap:/usr/share/etc/mailcap:/usr/etc/mailcap" unless $mailcaps;
  361. foreach (split(/:/,$mailcaps)) {
  362.     ReadMailcap($_);
  363. }
  364.  
  365. foreach (@files) {
  366.     my($type,$code,$file) = m/^(.*?):(.*?):(.*)$/;
  367.     print STDERR "Processing file \"$file\" of type \"$type\" (encoding=",$code?$code:"none",")...\n" if $debug;
  368.  
  369.     if ($file ne '-') {
  370.         if ($action eq 'compose' || $action eq 'edit') {
  371.             if (-e $file) {
  372.                 if (! -w $file) {
  373.                     print STDERR "Error: no write permission for file \"$file\"\n";
  374.                     $retcode = 2 if ($retcode < 2);
  375.                     next;
  376.                 }
  377.             } else {
  378.                 if (open(TEST,">$file")) {
  379.                     close(TEST);
  380.                     unlink($file);
  381.                 } else {
  382.                     print STDERR "Error: no write permission for file \"$file\"\n";
  383.                     $retcode = 2 if ($retcode < 2);
  384.                     next;
  385.                 }
  386.             }
  387.         } else {
  388.             if (! -e $file) {
  389.                 print STDERR "Error: no such file \"$file\"\n";
  390.                 $retcode = 2 if ($retcode < 2);
  391.                 next;
  392.             }
  393.             if (! -r $file) {
  394.                 print STDERR "Error: no read permission for file \"$file\"\n";
  395.                 $retcode = 2 if ($retcode < 2);
  396.                 next;
  397.             }
  398.         }
  399.     }
  400.  
  401.     my(@matches,$entry,$res,$efile);
  402.     if ($code) {
  403.         $efile = $file;
  404.         $file  = DecodeFile($efile,$code,$action);
  405.         next unless $file;
  406.     }
  407.  
  408.     foreach $entry (@mailcap) {
  409.         $entry =~ m/^(.*?)\s*;/;
  410.         $_ = "\Q$1\E"; s/\\\*/\.\*/g;
  411.         push @matches,$entry if ($type =~ m!^$_$!i);
  412.     }
  413.     @matches = grep(/\Q$action\E=/,@matches) unless $action eq "view";
  414.  
  415.     my $done=0;
  416.     my $fail=0;
  417.     foreach $match (@matches) {
  418.         my $comm;
  419.         print STDERR " - checking mailcap entry \"$match\"\n" if $debug;
  420.         if ($action eq "view") {
  421.             ($comm) = ($match =~ m/^.*?;\s*(.*?)\s*($|;)/);
  422.         } else {
  423.             ($comm) = ($match =~ m/\Q$action\E=(.*?)\s*($|;)/);
  424.         }
  425.         next if (!$comm || $comm =~ m!(^|/)false$!i);
  426.         print STDERR " - program to execute: $comm\n" if $debug;
  427.  
  428.         if ($match =~ m/;\s*test=(.*?)\s*($|;)/) {
  429.             my $test;
  430.             print STDERR " - running test: $1 " if $debug;
  431.             $test   = system "$1 >/dev/null 2>&1";
  432.             $test >>= 8;
  433.             print STDERR " (result=$test=",($test!=0?"false":"true"),")\n" if $debug;
  434.             if ($test) {
  435.                 $fail++;
  436.                 next;
  437.             }
  438.         }
  439.  
  440.         my($tmpfile,$tmplink);
  441.         if ($action ne 'print' && $match =~ m/;\s*needsterminal\s*($|;)/ && ! -t STDOUT) {
  442.             if ($ENV{DISPLAY}) {
  443.                 $comm = "$xtermprgrm -T '$file ($type)' -e $0 --action=$action '${type}:%s'";
  444.             } else {
  445.                 print STDERR " - no terminal available for rule (needsterminal)\n" if $debug;
  446.                 $fail++;
  447.                 next;
  448.             }
  449.         } elsif ($action eq 'view' && $match =~ m/;\s*copiousoutput\s*($|;)/) {
  450.             $comm .= " | $0 --action=$action text/plain:-";
  451.         }
  452.  
  453.         if ($file ne "-") {
  454.             if ($comm =~ m/[^%]%s/) {
  455.                 if ($file =~ m![^ a-z0-9,.:/@%^+=_-]!i) {
  456.                     $match =~ m/nametemplate=(.*?)\s*($|;)/;
  457.                     my $prefix = $1;
  458.                     my $linked = 0;
  459.                     while (!$linked) {
  460.                         $tmplink = TempFile($prefix);
  461.                         unlink($tmplink);
  462.                         if ($file =~ m!^/!) {
  463.                             $linked = symlink($file,$tmplink);
  464.                         } else {
  465.                             my $pwd = `/bin/pwd`;
  466.                             chomp($pwd);
  467.                             $linked = symlink("$pwd/$file",$tmplink);
  468.                         }
  469.                     }
  470.                     print STDERR " - filename contains shell meta-characters; aliased to '$tmplink'\n" if $debug;
  471.                     $comm =~ s/([^%])%s/$1$tmplink/g;
  472.                 } else {
  473.                     $comm =~ s/([^%])%s/$1$file/g;
  474.                 }
  475.             } else {
  476.                 if ($comm =~ m/\|/) {
  477.                     $comm =~ s/\|/<\Q$file\E \|/;
  478.                 } else {
  479.                     $comm .= " <\Q$file\E";
  480.                 }
  481.                 if ($action eq 'edit' || $action eq 'compose') {
  482.                     $comm .= " >\Q$file\E";
  483.                 }
  484.             }
  485.         } else {
  486.             if ($comm =~ m/[^%]%s/) {
  487.                 $tmpfile = SaveStdin($match);
  488.                 $comm =~ s/([^%])%s/$1$tmpfile/g;
  489.             } else {
  490.                 # no name means same as "-"... read from stdin
  491.             }
  492.         }
  493.  
  494.         $comm =~ s!([^%])%t!$1$type!g;
  495.         $comm =~ s!([^%])%F!$1!g;
  496.         $comm =~ s!%{(.*?)}!$_="'$ENV{$1}'";s/\`//g;$_!ge;
  497.         $comm =~ s!\\(.)!$1!g;
  498.         $comm =~ s!\'\'!\'!g;
  499.         $comm =~ s!$quotedsemi!;!go;
  500.         $comm =~ s!$quotedprct!%!go;
  501.  
  502.         print STDERR " - executing: $comm\n" if $debug;
  503.         $res = system $comm;
  504.         $res = int($res/256);
  505.         if ($res != 0) {
  506.             print STDERR "Warning: program returned non-zero exit code \#$res\n";
  507.             $retcode = $res;
  508.         }
  509.         $done=1;
  510.         unlink $tmpfile if $tmpfile;
  511.         unlink $tmplink if $tmplink;
  512.         last;
  513.     }
  514.  
  515.     if (!$done) {
  516.         if ($fail) {
  517.             print STDERR "Error: no \"$action\" rule for type \"$type\" passed its test case\n";
  518.             print STDERR "       (for more information, add \"--debug=1\" on the command line)\n";
  519.             $retcode = 3 if ($retcode < 3);
  520.         } else {
  521.             print STDERR "Error: no \"$action\" mailcap rules found for type \"$type\"\n";
  522.             $retcode = 3 if ($retcode < 3);
  523.         }
  524.         unlink $file if $code;
  525.         $retcode = 1 unless $retcode;
  526.         next;
  527.     }
  528.  
  529.     if ($code) {
  530.         if ($action eq 'edit' || $action eq 'compose') {
  531.             my $file = EncodeFile($file,$efile,$code);
  532.             unlink $file if $file;
  533.         } else {
  534.             unlink $file;
  535.         }
  536.     }
  537. }
  538.  
  539. exit($retcode);
  540.